home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / asol.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  6KB  |  184 lines
  1. /* asol.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     doublereal value[200000];
  33. } blank_;
  34.  
  35. #define blank_1 blank_
  36.  
  37. /*<       subroutine asol >*/
  38. /* Subroutine */ int asol_()
  39. {
  40.     /* System generated locals */
  41.     integer i_1;
  42.  
  43.     /* Local variables */
  44.     static integer iord, jord;
  45.     extern /* Subroutine */ int copy8_();
  46.     static integer i, j, k, locnn;
  47.     extern integer indxx_();
  48. #define nodplc ((integer *)&blank_1)
  49. #define cvalue ((complex *)&blank_1)
  50.     static integer loc;
  51.  
  52. /*<       implicit double precision (a-h,o-z) >*/
  53.  
  54. /*     this routine evaluates the adjoint circuit response by doing a */
  55. /* forward/backward substitution on the transpose of the coefficient */
  56. /* matrix. */
  57.  
  58. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  59. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  60. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  61. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  62. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  63. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  64. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  65. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  66. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  67. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  68. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  69. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  70. /* spice version 2g.6  sccsid=blank 3/15/83 */
  71. /*<       common /blank/ value(200000) >*/
  72. /*<       integer nodplc(64) >*/
  73. /*<       complex cvalue(32) >*/
  74. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  75.  
  76. /*  forward substitution */
  77.  
  78. /*<       do 20 i=2,nstop >*/
  79.     i_1 = cirdat_1.nstop;
  80.     for (i = 2; i <= i_1; ++i) {
  81. /*<       iord=nodplc(icswpf+i) >*/
  82.     iord = nodplc[tabinf_1.icswpf + i - 1];
  83. /*<       loc=i >*/
  84.     loc = i;
  85. /*<    10 loc=nodplc(irpt+loc) >*/
  86. L10:
  87.     loc = nodplc[tabinf_1.irpt + loc - 1];
  88. /*<       if (nodplc(irowno+loc).ge.i) go to 15 >*/
  89.     if (nodplc[tabinf_1.irowno + loc - 1] >= i) {
  90.         goto L15;
  91.     }
  92. /*<       j=nodplc(irowno+loc) >*/
  93.     j = nodplc[tabinf_1.irowno + loc - 1];
  94. /*<       jord=nodplc(icswpf+j) >*/
  95.     jord = nodplc[tabinf_1.icswpf + j - 1];
  96. /*<       value(lvn+iord)=value(lvn+iord)-value(lvn+loc)*value(lvn+jord) >*/
  97.     blank_1.value[tabinf_1.lvn + iord - 1] -= blank_1.value[tabinf_1.lvn 
  98.         + loc - 1] * blank_1.value[tabinf_1.lvn + jord - 1];
  99. /*<       go to 10 >*/
  100.     goto L10;
  101. /*<    15 jord=nodplc(irswpf+i) >*/
  102. L15:
  103.     jord = nodplc[tabinf_1.irswpf + i - 1];
  104. /*<       locnn=indxx(jord,iord) >*/
  105.     locnn = indxx_(&jord, &iord);
  106. /*<       value(lvn+iord)=value(lvn+iord)/value(lvn+locnn) >*/
  107.     blank_1.value[tabinf_1.lvn + iord - 1] /= blank_1.value[tabinf_1.lvn 
  108.         + locnn - 1];
  109. /*<    20 continue >*/
  110. /* L20: */
  111.     }
  112.  
  113. /*  backward substitution */
  114.  
  115. /*<       i=nstop >*/
  116.     i = cirdat_1.nstop;
  117. /*<    30 i=i-1 >*/
  118. L30:
  119.     --i;
  120. /*<       if (i.le.1) go to 60 >*/
  121.     if (i <= 1) {
  122.     goto L60;
  123.     }
  124. /*<       iord=nodplc(icswpf+i) >*/
  125.     iord = nodplc[tabinf_1.icswpf + i - 1];
  126. /*<       loc=i >*/
  127.     loc = i;
  128. /*<    35 loc=nodplc(irpt+loc) >*/
  129. L35:
  130.     loc = nodplc[tabinf_1.irpt + loc - 1];
  131. /*<    40 if (nodplc(irowno+loc).ne.i) go to 35 >*/
  132. /* L40: */
  133.     if (nodplc[tabinf_1.irowno + loc - 1] != i) {
  134.     goto L35;
  135.     }
  136. /*<    50 loc=nodplc(irpt+loc) >*/
  137. L50:
  138.     loc = nodplc[tabinf_1.irpt + loc - 1];
  139. /*<       if (loc.eq.0) go to 30 >*/
  140.     if (loc == 0) {
  141.     goto L30;
  142.     }
  143. /*<       j=nodplc(irowno+loc) >*/
  144.     j = nodplc[tabinf_1.irowno + loc - 1];
  145. /*<       jord=nodplc(icswpf+j) >*/
  146.     jord = nodplc[tabinf_1.icswpf + j - 1];
  147. /*<       value(lvn+iord)=value(lvn+iord)-value(lvn+loc)*value(lvn+jord) >*/
  148.     blank_1.value[tabinf_1.lvn + iord - 1] -= blank_1.value[tabinf_1.lvn + 
  149.         loc - 1] * blank_1.value[tabinf_1.lvn + jord - 1];
  150. /*<       go to 50 >*/
  151.     goto L50;
  152.  
  153. /*     reorder solution vector */
  154.  
  155. /*<    60 do 70 i=1,nstop >*/
  156. L60:
  157.     i_1 = cirdat_1.nstop;
  158.     for (i = 1; i <= i_1; ++i) {
  159. /*<       j=nodplc(irswpr+i) >*/
  160.     j = nodplc[tabinf_1.irswpr + i - 1];
  161. /*<       k=nodplc(icswpf+j) >*/
  162.     k = nodplc[tabinf_1.icswpf + j - 1];
  163. /*<       value(lvntmp+i)=value(lvn+k) >*/
  164.     blank_1.value[tabinf_1.lvntmp + i - 1] = blank_1.value[tabinf_1.lvn + 
  165.         k - 1];
  166. /*<    70 continue >*/
  167. /* L70: */
  168.     }
  169. /*<       call copy8(value(lvntmp+1),value(lvn+1),nstop) >*/
  170.     copy8_(&blank_1.value[tabinf_1.lvntmp], &blank_1.value[tabinf_1.lvn], &
  171.         cirdat_1.nstop);
  172.  
  173. /*  finished */
  174.  
  175. /*<       return >*/
  176.     return 0;
  177. /*<       end >*/
  178. } /* asol_ */
  179.  
  180. #undef cvalue
  181. #undef nodplc
  182.  
  183.  
  184.